--- Test 'HashMap' properties
module tests.qc.HM where

import Test.QuickCheck
import Data.HashMap H hiding(!!)

instance  (Eq k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
    arbitrary = fromList <$> arbitrary 

--- invariants are met before and after insert
p_invInsert = property hminsert
    where
        hminsert :: HashMap String Int -> String -> Int -> Bool
        hminsert hm s i = hm.invariants && (H.insert s i hm).invariants

--- invariants are met before and after delete
p_invDelete = property hmdelete
    where
        hmdelete :: HashMap Byte Int -> Byte -> Bool
        hmdelete hm k = hm.invariants && (H.delete k hm).invariants

--- invariants are met after union
p_invUnion = property prop
    where
        prop ∷ HashMap String Int → HashMap String Int -> Bool
        prop left right = HashMap.invariants $ union left right
{-- 
    check the property that first inserted values are not evaluated,
    unless the update function is strict in the second argument.
-}
p_undefUpdate = once prop
    where 
        -- prop :: HashMap String Int -> Bool
        prop = maybe false (==7) 
                    . H.lookup "foo" 
                    . H.insert "foo" 7 
                    . H.insert "foo" undefined
                    . H.delete "foo"

--- a previously inserted value will be found by lookup
p_lookupJust = property hmlookup
    where
        hmlookup :: HashMap String Int -> String -> Int -> Property
        hmlookup hm s i = collect 
                ("map size <%3d00".format (1 + H.size hm `quot` 100) :: String) 
                (lookup s (insert s i hm) == Just i)

--- a previously deleted value will not be found by lookup
p_lookupNothing = property prop
    where
        prop :: HashMap Byte Int -> Byte -> Property
        prop hm k = collect 
                (maybe "non existing key" (const "existing key") (lookup k hm)) 
                (lookup k (delete k hm) == Nothing)

--- deleting all possible keys will leave an empty map
p_deleteAll = property prop
    where
        prop :: HashMap Byte Int -> Property
        prop hm = collect 
                ("map size <%3d00".format (1 + H.size hm `quot` 100) :: String)
                (HashMap.null (foldr delete hm all))
        all = [minBound .. maxBound] 
 
--- A maps size is the same as the length of the keys list
p_sizekeys = property prop
    where
        prop ∷ HashMap String Float → Bool
        prop hm = size hm == length (keys hm)

--- keys and values can be created from each, and vice versa
p_kveach = property prop
    where
        prop ∷ HashMap String Double → Bool
        prop hm = each hm == zip (keys hm) (values hm)

--- keys from a HashMap are unique
p_uniqueKeys = property prop
    where
        prop ∷ HashMap String Double → Bool
        prop hm = uni (keys hm)
        uni (x:xs) = x `notElem` xs && uni xs
        uni []  = true
        uni [x] = true

--- the size of the union of a and b is between max(size a)(size b) and (size a) + (size b)
p_sizeUnion = property prop
    where
        prop ∷ HashMap String Double → HashMap String Double → Property
        prop hm1 hm2 = collect
            ("union map size <%3d00".format (1 + sz `quot` 100) :: String)
            (max s1 s2 <= sz && sz <= s1+s2)
            where
                hm = hm1 `union` hm2
                s1 = size hm1
                s2 = size hm2
                sz = size hm

--- all keys of the union of a and b can be found in a or b
p_keyUnion1 = property prop
    where
        prop ∷ HashMap String Double → HashMap String Double → Property
        prop hm1 hm2 = collect
            ("union map size <%3d00".format (1 + sz `quot` 100) :: String)
            (all (\k → k `member` hm1 || k `member` hm2) (keys hm))
            where
                hm = hm1 `union` hm2
                sz = size hm

--- all keys of a and all keys of b can be found in the union of a and b
p_keyUnion2 = property prop
    where
        prop ∷ HashMap String Double → HashMap String Double → Property
        prop hm1 hm2 = collect
            ("union map size <%3d00".format (1 + sz `quot` 100) :: String)
            (all (`member` hm) (keys hm1) 
                && all (`member` hm) (keys hm2))
            where
                hm = hm1 `union` hm2
                sz = size hm

--- the values are combined correctly by 'unionWith'
p_unionWith = property prop
    where
        prop ∷ HashMap Byte Int → HashMap Byte Int → Property
        prop hm1 hm2 = collect
            (if null hm
                then "null union"
                else "<=%2d0%% common keys".format (10*length common `quot` size hm))
            (all (\k → k `lookup` hm == liftM2 (-) (k `lookup` hm1) (k `lookup` hm2)) common)
            where
                hm = unionWith (-) hm1  hm2
                common = [ k | k <- keys hm, k `member` hm1, k `member` hm2 ]

--- check 'map' and 'fold'
p_mapFoldValues = property prop
    where
        prop ∷ HashMap String Double → Bool
        prop hm = foldValues (+) 0 (mapValues (const 1) hm) == size hm

--- check 'filterWithKey'
p_filterWithKey = property prop 
    where
        prop ∷ HashMap Byte Short → Bool
        prop = all (uncurry p) . each . filterWithKey p
        p k v = even k == even v

--- check 'Eq' instance
p_Eq = property prop
    where
        prop :: HashMap String Long → Bool
        prop hm = hm == fromList (each hm) && hm == fromList (reverse (each hm))